perm filename SCMSS.F4[NEW,LCS]30 blob
sn#652672 filedate 1982-04-12 generic text, type T, neo UTF8
C**** SCMSS.F4 ****
COPYRIGHT 1982 BY LELAND SMITH
C****** SCMSS, A2READ, INPOUT *********** 12/1/75
SUBROUTINE SCMSS
COMMON /PLTR/PLT,RHT,DIS/PTR/KWDS(1)
1 /MKX/KSLA,ISM,LESS,IGT,NNO(5),MINUS
CC 1 STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB /JCHAR/IXX,ISEMI,IBLA
COMMON/RINP/R(10,85),RPOS(2,50) /RMOD/RMODE2,SET4,IBEAM,NOSET,
1 STEM,STUP,NTC,PS2,RAM,RDD,ITB,POSB
1 /A2Z/LAA,LBB,A1(4),LGG,A2(6),LNN,LOH,A3(3),LSS,LTT,A4(4),LYY
1 /NUM/NUM(9),N9
COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
DIMENSION RLIST(200),NOMOR(6),WARN(6),ISV(5)
C /SCX/ ALSO IN WORDS, NEWR
COMMON/SCX/ICM,NEG,IDOT,IEQ,ILP,IRP,IPL,ISTAR,ICOL,ISEMI,IDB
1,IBLA,JF(3),IAT,JAL(14),RB,RC,JZ,IRHY,JD,KA,KB,IZ
1/STF/RSTFAC(8),RSTJ2 /LIMIT/LIMIT,ITEM,LL,IS,IX
1 /FRMT/F78F(1),FA1(1),FA5(1) /IDEV/IDEV
1/XRN/RN(1) /ALF/INP(72),ML /POS/POS1,POS2,PSFB
COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
1,NFLG,JXX,ISEMX,JG,VX(50),IAMP,K,KN,M,MODE,IBLX
EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3)),
1(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST)
1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
CC 1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
CC 1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
CC 1JALPHA(3))
C--THESE ARE IN 'RESTS' NOW. DATA IXX/'X'/,LCNT/1/,ISEMI/';'/,IBLA/' '/
JDEV=IDEV
JBKUP=0
C JBKUP IS TO TRAP MORE THAN ONE BACKUP IN A ROW.
1177 RB=0
IF(JA.NE.140)GO TO 11
77 MODE=1
IF(IDEV.NE.5)GO TO 177
C NEXT LOOKS FOR NAME TO SAVE INPUT (TYPE 'INn NAME')
DO 1377 K=3,72
L=K
IZ=INP(K)
1377 IF(IZ.LT.0)GO TO 2377
C JUMP OUT IF LETTER FOUND FIRST
NAMSC='INPUT'
GO TO 3377
2377 CALL NAMEXT(INP(L),NAMSC,K)
3377 CALL OFILE(21,NAMSC)
C12/80 WRITE(21,2114)INP
CALL INPOUT
C WRITE OUT 'IN' ETC.
177 IBEAM=-1
IZ=0
POS2=0
POS1=0
CC THIS IS SET IN MSX NOW **** RMODE2=R3
91 CALL TYPCRL
CALL TYPSTR('STAFF=')
CALL TYPFLT(STAFF)
IF(SET4.EQ.999.)GO TO 911
912 CALL TYPSTR(' SPACING STAFF=')
CALL TYPFLT(SET4)
911 CALL TYPCRL
GO TO 111
11 RB=0
IF(MODE.LE.2)GO TO 111
IF(IDEV.NE.5)GO TO 111
C SKIP IF READING AN EDIT FILE
CALL DPYOUT(3)
CALL ACCPOG(1)
CALL DPYOUT(1)
C THIS TO DISPLAY NOTE NUMS. ON DATA-DISK.
GO TO 111
467 IDEV=5
GO TO 4333
444 SET4=RA
GO TO 912
111 CALL SETUP
IF(STUP.GE.0)GO TO 8
C SKIPS IF USING SETUP ON SOME STAFF
IF(POS2.NE.0)GO TO 4334
C JUMP IF POS1, POS2, ETC. WERE SET UP IN FILE (* SP ST POS1 POS2 X)
4333 IF(IDEV.EQ.5)CALL TYPSTR('TYPE POS1, POS2, (SPC) ')
READ(IDEV,F78F,END=467)POS1,POS2,PSFB
C 'REREAD' IS NEEDED BECAUSE OF SOME FORTRAN BUG!!!!!!!!!!!!!!!!!!!!!!
C DON'T USE INVIS. RESTS WITH SPACING FEATURE!!!!
REREAD 2114,INP
C IF(IDEV.NE.5)GO TO 5333
C WRITE(21,2114)INP
IF(IDEV.EQ.5)CALL INPOUT
C12/80 IF(IDEV.EQ.5)WRITE(21,2114)INP
C WRITE OUT SPACING INFO
5333 CALL A2READ(K,RA)
IF(K.EQ.'SP')GO TO 444
C TYPE "SPn" TO SET SPACING STAFF AT THIS POINT.
IF(K.EQ.IAT)GO TO 467
CATCH '@' WHEN POS1 AND P2 ARE EXPECTED.
IF(K.EQ.LESS)GO TO 467
IF(K.NE.IGT)GO TO 567
IDEV=1
GO TO 4333
567 IF(POS2.EQ.0)POS2=200.
IF(POS1.GE.POS2)GO TO 4333
C TYPE ANY POSITIVE 3RD NUM. FOR PSUEDO-FIBONACCI SPACING OF RHYTH.
IF(INP1.GT.0)GO TO 4334
CCC NOW FOUND LETTER WHERE WE WANT NUMB.
IF(IDEV.EQ.5)GO TO 4333
CALL TYPSTR(' POS1, POS2 MISSING')
CALL TYPCRL
GO TO 999
4334 STUP=STUP-PSFB
8 CALL TYPCRL
367 GO TO (1,2,3,4,5,677)MODE
GO TO 80041
2111 IDEV=JDEV
RETURN
CC168 IF(NOSET.EQ.0)RETURN
80052 FORMAT(F,A4,A5,2F)
267 IDEV=5
IF(MODE.EQ.3)CALL NOTNUM
GO TO 2111
4 IF(IDEV.EQ.5)CALL TYPSTR('ADD BEAMS? ')
330 READ(IDEV,2114,END=677)INP
CALL LULOOP
IF(INP1.EQ.LGG)GO TO 677
C TYPE 'GO' TO PASS LATER ITEMS
IF(INP1.EQ.N9.AND.INP2.EQ.INP1)GO TO 99
IF(INP1.EQ.LBB)GO TO 99
IF(INP1.EQ.LYY)GO TO 1
C FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
IF(INP1.EQ.LNN)GO TO 2000
IF(INP1.EQ.ISEMI)GO TO 2000
IF(INP1.EQ.LESS)GO TO 267
IF(INP1.NE.IGT)GO TO 767
IDEV=1
766 GO TO(1,2,3,4,5)MODE
767 IF(INP1.NE.IBLA)GO TO 5177
2000 MODE=MODE+1
IF(IDEV.EQ.5)WRITE(21,2114)INP4
GO TO 11
690 REND=1
GO TO 2111
3 IF(IDEV.EQ.5)CALL TYPSTR('ADD MARKS? ')
GO TO 330
5 IF(IDEV.EQ.5)CALL TYPSTR('ADD SLURS? ')
GO TO 330
8006 MODE=MODE+1
IF(MODE.GT.5)GO TO 677
IF(IDEV.NE.5)GO TO 367
C RETURN ONLY IF IN TTY MODE. (NOT READING A FILE)
GO TO 2111
677 IF(IDEV.NE.5)GO TO 68
END FILE 21
CALL TYPSTR('INPUT SAVED ON ')
CALL TYPSTR(NAMSC)
CALL TYPSTR('.DAT')
CALL TYPCRL
68 REND=-1
GO TO 2111
99 IF(INP3.EQ.N9)GO TO 999
C ELSE GET ANOTHER CHANCE TO SAY 'NO'. 99=BACKUP, 999=ESCAPE
IF(MODE.GE.4)GO TO 1999
IF(JBKUP.LT.0)GO TO 199
JBKUP=-1
MODE=MODE-1
IF(MODE.EQ.0)GO TO 999
IS=ISV(MODE)
GO TO 11
C INSERT BACKUP ROUTINE
999 REND=99
GO TO 2111
C FIX BACKUPS********
199 CALL TYPSTR('ONLY 1 BACKUP AT A TIME. ')
299 CALL TYPSTR('CONTINUE, THEN EDIT .DAT FILE LATER, OR TYPE 999.')
CALL TYPCRL
GO TO 367
1999 CALL TYPSTR('CANNOT BACKUP AFTER MARKS INPUT.')
CALL TYPCRL
GO TO 299
8015 RA=0
DO 15 J=1,I-1
15 RA=RA+4./V(J)
K=IRHY-I+1
CALL TYPSTR('TOTAL RHY=')
CALL TYPFLT(RA)
CALL TYPSTR(' QTRS. ')
CALL TYPINT(K)
CALL TYPSTR(' MORE RHYTHMS NEEDED')
CALL TYPCRL
IDEV=5
C RETURNS TO TTY MODE IF READING A FILE WITH 'FILE' FEATURE.
2 IF(IDEV.EQ.5)CALL TYPSTR('TYPE ')
CALL TYPINT(IRHY)
CALL TYPSTR(' RHYTHMS')
CALL TYPCRL
1 ISV(MODE)=IS
CALL TYPE
CC IF(MODE.EQ.2)CALL RHQUIK
C RHQUIK ALLOWS TYPING RHYTHMS ON BOTTOM LEVEL OF KYBD.
C Z=WHOLE, X=HALF, C=QUARTER, V=EIGHTH, B=SIXTEENTH.
IF(INP1.NE.IAT)GO TO 1001
C '@' STARTS MODE2 INPUT
IF(INP2.NE.IBLA)GO TO 1001
C BUT NOT IF IT'S REALLY A MOTIVE CALL
IF(IDEV.EQ.5)END FILE 21
C CLOSE THE BACKUP FILE
CALL PRESCN
CALL IFILE(22,'MODE2')
READ(22,2114)INP
CALL LULOOP
IDEV=22
C IDEV CHANGES BACK BEFORE RETURN TO MAIN.
Z=STUP
CALL SETUP
C MUST RECALL SETUP BECAUSE SOME ARRAYS WERE USED IN PRESCN.(??)
STUP=Z
GO TO 6177
1001 CALL LULOOP
CALL A2READ(RA,RB)
IF(RA.NE.'SP')GO TO 5177
SET4=RB
C CAN SET SPACER HERE
GO TO 1177
5177 IF(INP1.EQ.IBLA) GO TO 1
IF(INP1.NE.N9)GO TO 80041
IF(INP2.EQ.N9)GO TO 99
C TYPE '99' TO BACK-UP
80041 IF(IDEV.EQ.5)CALL INPOUT
C12/80 80041 IF(IDEV.EQ.5)WRITE(21,2114)INP
6177 CALL LNEND
IF(INP1.EQ.ISEMI)GO TO 7774
C INP1=; MEANS UNTERMINATED LINE WAS TYPED. GO TRY AGAIN.
GO TO(333,433,533)MODE-2
C GO TO MARKZ, BEAMS, SLURZ
RETRO=-1.
I=1
PARENS=0
MOT=0
JZ=1
IAMP=0
C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
KL=0
RA=0
IF(MODE.EQ.2)GO TO 2408
C NEXT CHECKS FOR STAFF NUM AT FRONT OF INPUT LINE#1.
IF(INP1.NE.LSS)GO TO 2408
IF(INP2.NE.LTT)GO TO 2408
K=1
L=3
IF(INP3.NE.MINUS)GO TO 1277
K=-1
L=4
1277 STAFF=NALF(INP(L))*K
2277 MLX=L+1
IF(INP(MLX).NE.KSLA)GO TO 2277
MLX=MLX+1
GO TO 3277
2408 MLX=1
3277 L=-1
C GO SORT OUT THE NEW FORMAT
DO 2999 K=1,72
N=INP(K)
IF(N.EQ.IBLA)GO TO 2999
L=0
IF(N.EQ.ISTAR)GO TO 277
IF(N.NE.ISEMI)GO TO 2999
C READS 72 CHARS. INCLUDING ;.
277 INP(K+1)=ISEMI
GO TO 1773
C --- X/Y/Z* --- WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
2999 CONTINUE
7774 CALL TYPSTR('****** TRY AGAIN ***** ')
CALL TYPCRL
GO TO 766
CC GO TO 1
1299 IF(JZ.NE.0)GO TO 1773
7773 CALL TYPE
CC IF(MODE.EQ.2)CALL RHQUIK
C FOR Z=W, X=H, C=Q RHYTHMS, ETC.
IF(INP1.EQ.IBLA)GO TO 7773
IF(IDEV.EQ.5)CALL INPOUT
C12/80 IF(IDEV.EQ.5)WRITE(21,2114)INP
CALL LULOOP
77732 CALL LNEND
JM=-1
JZ=0
GO TO 2408
C 'LISTS' MUST END WITH ;
1773 JZ=0
DBST=1.
IF(XDBST)DBST=-DBST
XDBST=0
17731 ML=MLX
IF(PARENS.LE.0.)GO TO 975
C PARENS=-1, OPENS; =1, CLOSES; =0, NONE
3362 PARENS=0
MOT=I-LMOT
IF(LCNT+MOT.LT.198)GO TO 33621
CALL TYPSTR(' NO ROOM FOR MOTIVE ')
CALL TYPCHR(JMOT,1)
CALL TYPCRL
GO TO 1
33621 JLIST(LCNT+1)=MOT
LCNT=LCNT+2
DO 2140 JG=0,MOT-1
2140 RLIST(LCNT+JG)=V(LMOT+JG)
LCNT=LCNT+MOT
IF(IAMP)GO TO 3013
C FOR CLOSE PARENS ON LAST ITEM
C STORE MOTIVE IN RLIST ARRAY
975 DO 236 JDD=ML,72
JD=JDD
N=INP(JD)
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC. CAN USE 26 LABELS.
IF(N.EQ.ILP)GO TO 477
IF(N.EQ.IRP)GO TO 477
IF(N.NE.ICOL)GO TO 2361
477 INP(JD)=IBLA
IF(N.NE.ICOL)GO TO 1113
XDBST=-1.
GO TO 5362
C GO CHANGE IT TO A SEMIC. !!! CAN'T END LINE WITH :
C SO NXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
C DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
1113 L=JD-1
5113 IF(INP(L).NE.IBLA)GO TO 2113
L=L-1
GO TO 5113
2113 IF(N.EQ.IRP)GO TO 3361
C ONLY ONE () AS YET, NO NESTING
1140 JMOT=INP(L)
C MOTIVE NAME
DO 11401 JC=1,LCNT-1
IF(JMOT.NE.JLIST(JC))GO TO 11401
C FINDS DUPLICATE IDENTIFIER
CALL TYPSTR(' MOTIVIC (')
CALL TYPCHR(JMOT,1)
CALL TYPSTR(') USED TWICE')
CALL TYPCRL
JLIST(JC)=0
C ZERO OUT PREVIOUS USE OF IDENTIFIER.
11401 CONTINUE
JLIST(LCNT)=JMOT
PARENS=-1.
C A PARENTH IS OPEN
INP(L)=IBLA
LMOT=I
C LMOT IS CURRENT POINT IN V ARRAY
GO TO 236
3361 IF(PARENS.NE.0)GO TO 33612
CALL TYPSTR('PARENTH ERROR - GOING ON')
CALL TYPCRL
33611 INP(JD)=IBLA
GO TO 236
33612 PARENS=1.
C SETS PARENS CLOSED FLAG
GO TO 33611
C NO INVERSIONS POSSIBLE NOW
2361 IF(N.NE.IAT)GO TO 5361
DO 113 L=1,72
K=JD+L
C K IS USED AT 240!!!
JG=INP(K)
IF(JG.NE.NEG)GO TO 7113
RETRO=0
INP(K)=IBLA
GO TO 113
7113 IF(JG.NE.IBLA)GO TO 4113
113 CONTINUE
4113 DO 6361 L=1,LCNT
IF(JG.NE.JLIST(L))GO TO 6361
VX1=0
DO 40 M=JD+2,72
JG=INP(M)
IF(JG.EQ.IBLA)GO TO 40
IF(JG.EQ.KSLA)GO TO 140
IF(JG.EQ.ISEMI)GO TO 140
IF(JG.EQ.ISTAR)GO TO 140
ML=M
GO TO 240
40 CONTINUE
240 JC=JM
JM=-1
INP(K)=IBLA
JN=0
C MUST BE ZERO IN SCANR
CALL SCANR
JM=JC
140 JC=1
KN=L+2
M=KN+JLIST(L+1)
IF(RETRO)GO TO 940
KN=M-1
M=L+1
JC=-1
RETRO=-1.
940 Z=RLIST(KN)
IF(VX1.EQ.0)GO TO 540
C " @Q N " WHERE N= DIATONIC STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
IF(MODE.EQ.1)GO TO 440
C MODE 1 IS NOTES, 2 IS RHY.
V(I)=Z*VX1
GO TO 7361
440 IF(ABS(Z).GE.2000.)GO TO 540
C SKIPS NON-NOTES
RB=VX1
IF(Z)RB=-RB
C NOW TRANSPOSES BY DIAT. STEPS ONLY 100S=FLAT, 200S=SHARP, 300S=NAT
C NEG NUMS ARE CHORD NOTES.
V(I)=Z+RB
GO TO 7361
540 V(I)=Z
7361 I=I+1
KN=KN+JC
IF(KN.NE.M)GO TO 940
RB=V(I-1)
DO 8361 LI=JD,72
JG=INP(LI)
INP(LI)=IBLA
IF(JG.EQ.KSLA)GO TO 9361
IF(JG.EQ.ISEMI)GO TO 93611
8361 IF(JG.EQ.ISTAR)IAMP=-1
9361 MLX=LI
IF(IAMP.EQ.0)GO TO 17731
JZ=-1
93611 IF(IAMP)GO TO 3013
GO TO 7773
6361 CONTINUE
CALL TYPSTR(' MOTIVIC (')
CALL TYPCHR(JG,1)
CALL TYPSTR(') NOT FOUND')
CALL TYPCRL
GO TO 11401
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361 IF(N.NE.KSLA)GO TO 636
5362 MLX=JD+1
JZ=-1
INP(JD)=ISEMI
436 IF(INP(MLX).NE.IBLA)GO TO 103
MLX=MLX+1
GO TO 436
636 IF(N.EQ.ISEMI)GO TO 103
936 IF(N.NE.IDOT)GO TO 736
L=INP(JD+1)
KL=NALF(L)
IF(L.LE.0)GO TO 577
IF(KL.LT.0)GO TO 577
IF(KL.LE.9)GO TO 236
C JUMP IF IT'S A NUMBER
577 IF(MODE.EQ.2)INP(JD)=1
C :::::::::******* ↑↑↑↑ MODE #?
GO TO 236
C CHANGES DOTTED RHYTHMS TO '1'S.
736 IF(N.NE.ISTAR)GO TO 236
IAMP=-1
INP(JD)=ISEMI
GO TO 103
236 CONTINUE
2114 FORMAT(72A1)
CC21141 FORMAT(I,72A1)
5016 IF(IAMP.GE.0)GO TO 1299
IF(PARENS.NE.0)GO TO 3362
C PARENS ARE STILL OPEN?
GO TO 3013
103 K=INP(ML)
C LAST SECTION
IF(K.EQ.ISEMI)GO TO 1014
C*********** MODE #?
IF(K.NE.IBLA) GO TO 1899
ML=ML+1
GO TO 103
1899 JN=0
C MUST BE ZERO IN SCANR
VX4=0
NOAC=0
CALL SCANR
IF(VX1.EQ.-99.)GO TO 4022
C NO MORE COMPOSITES IN RHYTH. DOTS ARE INDICATED BY 100S.
C RHYTH. NUMB IS KEPT HERE. DOTTED QUARTER IS NOW 104. DBL..=204
17 IF(MODE.NE.2)GO TO 117
IF(JJ.EQ.1)GO TO 117
IF(VX2.EQ.0)GO TO 117
C VX2=0 IF "X" IS USED. (8X3 FORMS VX1=8, VX2=0, VX3=3)
RB=0
DO 2117 K=1,JJ
2117 RB=RB+4./VX(K)
VX1=4./RB
C FOR COMPOSITE RHYTHMS. (USEFUL FOR 'WHOLE' RESTS IN 5/4, ETC.)
JJ=1
117 V(I)=VX1
IF(VX4.EQ.0)GO TO 115
IF(MODE.NE.1)GO TO 115
I=I+1
C FOR + OR -. AUTO OCTAVES, ETC.
V(I)=-VX1-VX4
115 IF(JJ.LE.1)GO TO 114
IF(MODE.NE.1)GO TO 171
IF(VX2.EQ.0)GO TO 171
C JUMP IF RHY OR 'X 4' ETC.
V(I)=18000.0+VX1*10.0+VX2/10.0
C PACKS 2 METER NUMS INTO ONE SLOT (18xyz.n xy=top, zn=bottom)
114 I=I+1
GO TO 5016
171 JC=1
JD=VX(JJ)-1
I=I+1
GO TO 5005
1014 JD=1
JC=1
C X4/ CREATES REP 1,4; A/// CREATES REP 1,3;
GO TO 5005
4022 JC=VX2+.3
JD=VX3-.5
IF(MODE.EQ.1)NOAC=-1
C ACCIS WILL NOT!! REPEAT UNLESS 100 IS ADDED TO 1ST NUM.******6/78
IF(JJ.EQ.2)JD=1
C JD=HOW MANY TIMES, JC=HOW MANY NOTES
IF(JC.LT.100)GO TO 5005
C ADD 100 TO NUM OF NOTES TO REPEAT ACCIS WITH 'REP N1, N2'.
JC=JC-100
NOAC=0
5005 N=0
DO 3005 K=I-1,1,-1
IF(V(K))GO TO 3005
IF(V(K).LT.3000)N=N+1
C COUNTS RESTS AND NOTES ONLY (NO CHORD NOTES)
3005 IF(N.EQ.JC)GO TO 4005
4005 IF(JC.GT.1)GO TO 7005
IF(MODE.EQ.1)NOAC=-1
C 5/76 ******* AF/// WILL CREATE AF/A//-- AN:FS/// = AN:FS/A:F// *******
C ACCIS ARE DROPPED WITH / OR Xn REPEAT. (BUT NOT WITH 'REP' OR '/X n,n/')
7005 JC=I-K
C ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
C REPS WILL ONLY COUNT RHYTHMIC UNITS.!
DO 1005 K=1,JD
NL=I+JC-1
DO 2005 L=I,NL
KN=L-JC
RB=V(KN)
IF(NOAC.GE.0)GO TO 2005
IF(ABS(RB).GE.2000)GO TO 2005
C SKIP OVER IF NOT A NOTE
RB=AMOD(RB,100.0)+1000.0
IF(V(KN))RB=RB-2000.0
C DROPS ACCIS WHEN SLASH REP. OR 'X' IS USED.
2005 V(L)=RB
1005 I=I+JC
GO TO 5016
3013 IF(MODE.NE.2)GO TO 771
IF(I-1.NE.IRHY)GO TO 8015
C WRONG NUMBER OF ITEMS
771 V(I)=-99.
IF(MODE.NE.1)GO TO 132
C FOR ADDED NOTES ON SPACING STAFF
CALL NOTES
C SAVES TOTAL OF ITEMS FOR LABEL 168
67 CALL NEWR
IX=IS
C SAVE PTR TO RN ARRAY FOR TREM. OVER BEAM LATER. (IN 'BEAMS.F4')
GO TO 8006
132 CALL RHYTH
C =50 IS RHYTHM FOR TEXT
GO TO 67
134 IF(IDEV.EQ.5)CALL INPOUT
C12/80 134 IF(IDEV.EQ.5)WRITE(21,2114)INP
C WRITES TYPED IN REPLY TO 'ADD BEAMS?'
C ACCENTS ARE IN MARKZ SUBROUTINE
GO TO 8006
533 CALL SLURZ
GO TO 8006
433 CALL BEAMS
C ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
IBEAM=0
GO TO 8006
333 CALL MARKZ
135 K=IS
CALL NEWR
IS=K
C ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
GO TO 8006
END
SUBROUTINE A2READ(A,B)
REREAD 1,A,B
CALL LO2UP(A)
1 FORMAT(A2,F)
END
SUBROUTINE INPOUT
C WRITES TYPED INPUT TO FILE 'INPUT.DAT' (OR OTHER NAME)
COMMON /ALF/INP(1)
DO 1 K=72,1,-1
1 IF(INP(K).NE.' ')GO TO 2
K=1
2 WRITE(21,2114)(INP(J),J=1,K)
2114 FORMAT(72A1)
END